{ *********************************************************** }
{ *                    ksTools Library                      * }
{ *       Copyright (c) Sergey Kasandrov 1997, 2009         * }
{ *       -----------------------------------------         * }
{ *         http://sergworks.wordpress.com/kstools          * }
{ *********************************************************** }

unit TestUtils;
{

  Delphi DUnit Test Case
  ----------------------
  This unit contains a skeleton test case class generated by the Test Case Wizard.
  Modify the generated code to correctly setup and call the methods from the unit
  being tested.

}

interface

uses
  TestFramework, Windows, Forms, Dialogs, Controls, Classes, SysUtils, Variants,
  Graphics, Messages, ksUtils;

type
  TTestUtils = class(TTestCase)
  private
    Bytes1: TBytes;
    Bytes2: TBytes;
    procedure CompareBytesTests(Len: Integer);
    procedure EqualBytesTests(Len: Integer);
    procedure ScanBytesTests(BufLen, DataLen, DataOfs: Integer);
    procedure FindByteTests(BufLen, DataOfs: Integer; B: Byte);
    procedure FindByteBackTests(BufLen, DataOfs: Integer; B: Byte);
    procedure SwapBits32Test(Value: LongWord);
    procedure SwapBits16Test(Value: LongWord);
  protected
    procedure SetUp; override;
  published
    procedure TestCompareBytes;
    procedure TestEqualBytesLen;
    procedure TestScanBytes;
    procedure TestFindByte;
    procedure TestFindByteBack;
    procedure TestSwapBits32;
    procedure TestSwapBits16;
  end;

implementation

function SwapBits32Func(Value, Len: LongWord): LongWord;
begin
// swap odd and even bits
  Value:= ((Value shr 1) and $55555555) or ((Value and $55555555) shl 1);
// swap consecutive pairs
  Value:= ((Value shr 2) and $33333333) or ((Value and $33333333) shl 2);
// swap nibbles ...
  Value:= ((Value shr 4) and $0F0F0F0F) or ((Value and $0F0F0F0F) shl 4);
// swap bytes
  Value:= ((Value shr 8) and $00FF00FF) or ((Value and $00FF00FF) shl 8);
// swap 2-byte long pairs
  Value:= (Value shr 16) or (Value shl 16);
  Result:= Value shr (32 - Len);
end;

function SwapBits16Func(Value, Len: Word): Word;
begin
// swap odd and even bits
  Value:= ((Value shr 1) and $5555) or ((Value and $5555) shl 1);
// swap consecutive pairs
  Value:= ((Value shr 2) and $3333) or ((Value and $3333) shl 2);
// swap nibbles ...
  Value:= ((Value shr 4) and $0F0F) or ((Value and $0F0F) shl 4);
// swap bytes
  Value:= (Value shr 8) or (Value shl 8);
  Result:= Value shr (16 - Len);
end;


{ TestUtils }

{$O-}

procedure TTestUtils.CompareBytesTests(Len: Integer);
var
  I: Integer;
  B: Byte;

begin
  SetLength(Bytes1, Len);
  SetLength(Bytes2, Len);
  if Len > 0 then begin
    I:= 0;
    repeat
      B:= Random(256);
      Bytes1[I]:= B;
      Bytes2[I]:= B;
      Inc(I);
    until I = Len;
    I:= CompareBytes(@Bytes1[0], @Bytes2[0], Len);
    CheckTrue(I = 0);
    if B >= 128 then Bytes2[Len-1]:= B - 128
    else Bytes1[Len-1]:= B + 128;
    I:= CompareBytes(@Bytes1[0], @Bytes2[0], Len);
    CheckTrue(I > 0);
    if B >= 128 then begin
      Bytes1[Len-1]:= B - 128;
      Bytes2[Len-1]:= B;
    end
    else begin
      Bytes1[Len-1]:= B;
      Bytes2[Len-1]:= B + 128;
    end;
    I:= CompareBytes(@Bytes1[0], @Bytes2[0], Len);
    CheckTrue(I < 0);
  end
  else begin
    I:= CompareBytes(nil, nil, 0);
    CheckTrue(I = 0);
  end;
end;

procedure TTestUtils.EqualBytesTests(Len: Integer);
var
  I, N: Integer;
  B: Byte;

begin
  SetLength(Bytes1, Len);
  SetLength(Bytes2, Len);
  if Len > 0 then begin
    I:= 0;
    repeat
      B:= Random(256);
      Bytes1[I]:= B;
      Bytes2[I]:= B;
      Inc(I);
    until I = Len;
    I:= EqualBytesLen(@Bytes1[0], @Bytes2[0], Len);
    CheckTrue(I = Len);
    N:= Len;
    while N > 0 do begin
      Dec(N);
      if Bytes1[N] >= 128 then Dec(Bytes1[N], 128)
      else Inc(Bytes1[N], 128);
      I:= EqualBytesLen(@Bytes1[0], @Bytes2[0], Len);
      CheckTrue(I = N);
    end;
  end
  else begin
    I:= EqualBytesLen(nil, nil, 0);
    CheckTrue(I = 0);
  end;
end;

procedure TTestUtils.FindByteTests(BufLen, DataOfs: Integer; B: Byte);
var
  I: Integer;
  P: PByte;

begin
  SetLength(Bytes1, BufLen);
// fill buffer with buflen random bytes
  I:= 0;
  while (I < BufLen) do begin
    Bytes1[I]:= Random(256);
    Inc(I);
  end;
  if (DataOfs >= 0) then begin
    Bytes1[DataOfs]:= B;
    P:= FindByte(@Bytes1[0], B, BufLen);
    CheckTrue(P <> nil);
    CheckEquals(Cardinal(P^), Cardinal(B));
  end
  else begin
    P:= FindByte(@Bytes1[0], B, BufLen);
    if (P <> nil) then
      CheckEquals(Cardinal(P^), Cardinal(B));
  end;
end;

procedure TTestUtils.FindByteBackTests(BufLen, DataOfs: Integer; B: Byte);
var
  I: Integer;
  P: PByte;

begin
  SetLength(Bytes1, BufLen);
// fill buffer with buflen random bytes
  I:= 0;
  while (I < BufLen) do begin
    Bytes1[I]:= Random(256);
    Inc(I);
  end;
  if (DataOfs >= 0) then begin
    Bytes1[DataOfs]:= B;
    P:= FindByteBack(@Bytes1[0], B, BufLen);
    CheckTrue(P <> nil);
    CheckEquals(Cardinal(P^), Cardinal(B));
  end
  else begin
    P:= FindByteBack(@Bytes1[0], B, BufLen);
    if (P <> nil) then
      CheckEquals(Cardinal(P^), Cardinal(B));
  end;
end;

procedure TTestUtils.ScanBytesTests(BufLen, DataLen, DataOfs: Integer);
var
  I, N: Integer;
  B: Byte;

begin
  SetLength(Bytes1, BufLen);
  SetLength(Bytes2, DataLen);
  if BufLen > 0 then begin
// fill buffer with buflen random bytes
    I:= 0;
    repeat
      B:= Random(256);
      Bytes1[I]:= B;
      Inc(I);
    until I = BufLen;

    if (DataOfs >= 0) then begin
      if (DataLen + DataOfs <= BufLen) then begin
// copy DataLen bytes from Buffer to Data
        I:= 0;
        while (I < DataLen) do begin
          Bytes2[I]:= Bytes1[I + DataOfs];
          Inc(I);
        end;
        N:= ScanBytes(@Bytes1[0], @Bytes2[0], BufLen, DataLen);
// we should find Data in Buffer, but possibly before DataOfs
        CheckTrue((N >= 0) and (N <= DataOfs));
        for I:= 0 to DataLen - 1 do begin
          CheckEquals(Cardinal(Bytes1[N + I]), Cardinal(Bytes2[I]));
        end;
      end;
    end
    else begin
// fill data with datalen random bytes
      I:= 0;
      while (I < DataLen) do begin
        B:= Random(256);
        Bytes2[I]:= B;
        Inc(I);
      end;
      N:= ScanBytes(@Bytes1[0], @Bytes2[0], BufLen, DataLen);
// unlikely but possible that we have found Data
      if (N >= 0) then begin
        for I:= 0 to DataLen - 1 do begin
          CheckEquals(Cardinal(Bytes1[N + I]), Cardinal(Bytes2[I]));
        end;
      end;
    end;
  end;
end;

procedure TTestUtils.SetUp;
begin
  Randomize;
end;

procedure TTestUtils.SwapBits32Test(Value: LongWord);
var
  V1, V2: LongWord;
  Len: LongWord;

begin
  for Len:= 0 to 32 do begin
    V1:= ksUtils.SwapBits32(Value, Len);
    V2:= SwapBits32Func(Value, Len);
    CheckEquals(V1, V2);
  end;
end;

procedure TTestUtils.SwapBits16Test(Value: LongWord);
var
  V1, V2: Word;
  Len: Word;

begin
  for Len:= 0 to 16 do begin
    V1:= ksUtils.SwapBits16(Value, Len);
    V2:= SwapBits16Func(Value, Len);
    CheckEquals(Cardinal(V1), Cardinal(V2));
  end;
end;

procedure TTestUtils.TestCompareBytes;
const
  LoopCount = 100;

var
  Len, Count: Integer;

begin
  for Len:= 0 to 1000 do begin
    Count:= LoopCount;
    while Count > 0 do begin
      CompareBytesTests(Len);
      Dec(Count);
    end;
  end;
end;

procedure TTestUtils.TestEqualBytesLen;
const
  LoopCount = 10;

var
  Len, Count: Integer;

begin
  for Len:= 0 to 1000 do begin
    Count:= LoopCount;
    while Count > 0 do begin
      EqualBytesTests(Len);
      Dec(Count);
    end;
  end;
end;

procedure TTestUtils.TestFindByte;
var
  BufLen, DataOfs: Integer;
  B: Byte;

begin
  for B:= 0 to 10 do begin
    for BufLen:= 1 to 100 do begin
      FindByteTests(BufLen, -1, B);
      for DataOfs:= 0 to BufLen-1 do begin
        FindByteTests(BufLen, DataOfs, B);
      end;
    end;
  end;
end;

procedure TTestUtils.TestFindByteBack;
var
  BufLen, DataOfs: Integer;
  B: Byte;

begin
  for B:= 0 to 10 do begin
    for BufLen:= 1 to 100 do begin
      FindByteBackTests(BufLen, -1, B);
      for DataOfs:= 0 to BufLen-1 do begin
        FindByteBackTests(BufLen, DataOfs, B);
      end;
    end;
  end;
end;

procedure TTestUtils.TestScanBytes;
var
  BufLen, DataLen, DataOfs: Integer;

begin
  for BufLen:= 1 to 80 do begin
    for DataLen:= 1 to BufLen do begin
      ScanBytesTests(BufLen, DataLen, -1);
      for DataOfs:= 0 to BufLen - DataLen do begin
        ScanBytesTests(BufLen, DataLen, DataOfs);
      end;
    end;
  end;
  for BufLen:= 250 to 270 do begin
    for DataLen:= 1 to BufLen do begin
      ScanBytesTests(BufLen, DataLen, -1);
      for DataOfs:= 0 to BufLen - DataLen do begin
        ScanBytesTests(BufLen, DataLen, DataOfs);
      end;
    end;
  end;
end;

procedure TTestUtils.TestSwapBits32;
const
  Count = 100000;

var
  N: Integer;
  Value: LongWord;

begin
  N:= Count;
  repeat
    Value:= (Random($10000) shl 16) + Random($10000);
    SwapBits32Test(Value);
    Dec(N);
  until N = 0;
end;

procedure TTestUtils.TestSwapBits16;
const
  Count = 100000;

var
  N: Integer;
  Value: Word;

begin
  N:= Count;
  repeat
    Value:= Random($10000);
    SwapBits16Test(Value);
    Dec(N);
  until N = 0;
end;

initialization
  // Register any test cases with the test runner
  RegisterTest(TTestUtils.Suite);
end.

